unit DelphiGrammar;

interface

uses
  FormalGrammars,
  SysUtils;

const
  L_COMMENT1                    = 120;
  L_COMMENT2                    = L_COMMENT1 + 1;
  L_FREE                        = L_COMMENT2 + 1;
  L_COMMA                       = L_FREE + 1;
  L_SEMI_COLON                  = L_COMMA + 1;
  L_COLON                       = L_SEMI_COLON + 1;
  L_DOT                         = L_COLON + 1;
  L_EQUAL                       = L_DOT + 1;
  L_ASSIGN                      = L_EQUAL + 1;
  L_OPENED_ARC                  = L_ASSIGN + 1;
  L_CLOSED_ARC                  = L_OPENED_ARC + 1;
  L_OPENED_SQUARED_ARC          = L_CLOSED_ARC + 1;
  L_CLOSED_SQUARED_ARC          = L_OPENED_SQUARED_ARC + 1;
  L_PLUS                        = L_CLOSED_SQUARED_ARC + 1;
  L_MINUS                       = L_PLUS + 1;
  L_MULTYPLY                    = L_MINUS + 1;
  L_DIVIDE                      = L_MULTYPLY + 1;
  L_POINTER	                    = L_DIVIDE + 1;
  L_DOUBLE_DOT                  = L_POINTER + 1;

var
  Comma, OpMul, OpDiv, OpPointer, OpDoubleDot: ILexeme;
  SemiColon: ILexeme;
  Dot: ILexeme;
  Colon: ILexeme;
  Equal: ILexeme;
  Assign: ILexeme;
  OpenedArc, ClosedArc, OpenedSquaredArc, ClosedSquaredArc: ILexeme;
  Comment1, Comment2, f, mf: ILexeme;
  Goal, _Program, _Unit, _Library, _Package: ILexeme;
  Ident, IdentList, ProgramBlock, LabelId: ILexeme;
  InterfaceSection, ImplementationSection, InitSection: ILexeme;
  RequiresClause, ContainsClause, UsesClause, Block, InterfaceDecl: ILexeme;
  ConstSection, TypeSection, VarSection, ExportedHeading, LabelDeclSection: ILexeme;
  ProcedureHeading, FunctionHeading, Directive: ILexeme;
  DeclSection, CompoundStmt, ProcedureDeclSection, ConstantDecl: ILexeme;
  ConstExpr, TypedConstant, TypeId, TypeDecl, _Type, RestrictedType: ILexeme;
  ArrayConstant, RecordConstant, RecordFieldConstant: ILexeme;
  SimpleType, StrucType, PointerType, StringType, ProcedureType, VariantType, ClassRefType, ObjectType, ClassType, InterfaceType: ILexeme;
  OrdinalType, RealType, SubrangeType, EnumeratedType, OrdIdent: ILexeme;
  ArrayType, SetType, FileType, RecType, FieldList, FieldDecl, VariantSection, RecVariant: ILexeme;
  VarDecl, Expression, SimpleExpression, RelOp, Term, AddOp, Factor, MulOp, Designator, ExprList: ILexeme;
  SetConstructor, _String, Number, QualId, SetElement, Statement, SimpleStatement, StructStmt, StmtList: ILexeme;
  ConditionalStmt, LoopStmt, WithStmt, IfStmt, CaseStmt, CaseSelector, CaseLabel: ILexeme;
  RepeatStmt, WhileStmt, ForStmt, ProcedureDecl, FunctionDecl, FormalParameters, FormalParm: ILexeme;
  Parameter, ObjHeritage, ObjFieldList, MethodList, MethodHeading, ConstructorHeading, DestructorHeading: ILexeme;
  ClassHeritage, ClassFieldList, ClassMethodList, ClassPropertyList, ClassVisibility: ILexeme;
  PropertyList, PropertyInterface, PropertySpecifiers, PropertyParameterList: ILexeme;
  InterfaceHeritage, UnitId, TypeIdentifier, OpPlus, OpMinus: ILexeme;

procedure InitializeDelphiGrammar;

implementation

const
  AllChars: TSysCharSet = [Char(0)..Char(255)];

function Separated(const l: ILexeme): ILexeme;
begin
  Result := GSequence([
    mf,
    l,
    mf
  ]);
end;

function StringLexemeFilter(const s: string; var ind: Integer): Boolean;
var
  i, l: Integer;
begin
  Result := False;
  l := Length(s);
  if ind >= l then
    Exit;
  
  if s[ind] = '''' then
  begin
    i := ind + 1;


    while i < l do case s[i] of
        '''':
        begin
          if s[i + 1] = '''' then
            Inc(i, 2)
          else
          begin
            Result := True;
            ind := i + 1;         
            Exit;
          end;
        end;

        #13, #10:
        begin
          Result := False;
          Exit;
        end;

        else
          Inc(i);
      end;
    if s[l] = '''' then
    begin
      ind := l + 1;
      Result := True;
    end;
  end;
end;

function DesignatorLexemeFilter(const s: string; const l: ILexeme; const r: IMatchSuccess): Boolean;
begin
 // Checking designator to not equal 'end'
  Result := (r.ValueTo - r.ValueFrom <> 2) or (s[r.ValueFrom] <> 'e') or (s[r.ValueFrom + 1] <> 'n') or (s[r.ValueTo] <> 'd');
end;

procedure InitializeDelphiGrammar;
begin
  if Assigned(Comment1) then
    raise Exception.Create('Delphi grammar is already initialized');

  Comment1 := GSequence([
    GText('{'),
    GSymbols(AllChars - ['}']),
    GText('}')
  ], L_COMMENT1);

  Comment2 := GSequence([
    GText('//'),
    GSymbols(AllChars - [#10, #13]),
    GMaybe(GSymbols([#10, #13]))
  ], L_COMMENT2);

  f := GRepeat([
    GMaybe(GSymbols([' ', #10, #13, #9])),
    GMaybe(Comment1),
    GMaybe(Comment2)
  ], 1, L_FREE);

  mf := GMaybe(f);

  Comma := GText(',', L_COMMA);
  SemiColon := GText(';', L_SEMI_COLON);
  Colon := GText(':', L_COLON);
  Dot := GText('.', L_DOT);
  Equal := GText('=', L_EQUAL);
  Assign := GText(':=', L_ASSIGN);
  OpenedArc := GText('(', L_OPENED_ARC);
  ClosedArc := GText(')', L_CLOSED_ARC);
  OpenedSquaredArc := GText('[', L_OPENED_SQUARED_ARC);
  ClosedSquaredArc := GText(']', L_CLOSED_SQUARED_ARC);
  OpPlus := GText('+', L_PLUS);
  OpMinus := GText('-', L_MINUS);
  OpMul := GText('*', L_MULTYPLY);
  OpDiv := GText('/', L_DIVIDE);
  OpPointer :=  GText('^', L_POINTER);
  OpDoubleDot := GText('..', L_DOUBLE_DOT);

//String -> <string>
  _String := GFilter(StringLexemeFilter);
  _String := GRepeat(
    _String,
    Separated(OpPlus)
  );

  //Number -> <number>
  // TODO: What about non decimal based systems?
  Number := GSymbols(['0'..'9']);
  Number := GSequence([
    GMaybe(
      GSelect([
        OpPlus,
        OpMinus
      ])
    ),
    Number,
    GMaybe([
      Dot,
      Number
    ])
  ]);

//Ident -> <identifier>
  Ident := GSymbols(['A'..'Z', 'a'..'z', '0'..'9', '_']);
  TypeIdentifier := Ident;
//UnitId -> <unit-identifier>
  UnitId := Ident;
//LabelId -> <label-identifier>
  LabelId := Ident;

//TypeId -> [UnitId '.'] <type-identifier>
  TypeId := GSequence([
    GMaybe([
      UnitId,
      Dot
    ]),
    TypeIdentifier
  ]);

//AddOp -> '+'
//  -> '-'
//  -> OR
//  -> XOR
// TODO: Optimize following expression as the next one
  AddOp := GSelect([
    GSequence([
      mf,
      OpPlus
    ]),
    GSequence([
      mf,
      OpMinus
    ]),
    GSequence([
      f,
      GText('or')
    ]),
    GSequence([
      f,
      GText('xor')
    ])
  ]);

//MulOp -> '*'
//  -> '/'
//  -> DIV
//  -> MOD
//  -> AND
//  -> SHL
//  -> SHR
  MulOp := GSelect([
    GSequence([
      mf,
      GSelect([
        OpMul,
        OpDiv
      ])
    ]),
    GSequence([
      f,
      GSelect([
        GText('div'),
        GText('and'),
        GText('shl'),
        GText('shr')
      ])
    ])
  ]);


//RelOp -> '>'
//  -> '<'
//  -> '<='
//  -> '>='
//  -> '<>'
//  -> IN
//  -> IS
//  -> AS
  RelOp := GSelect([
    GSequence([
      mf,
      GSelect([
        GText('<>'),
        GText('<='),
        GText('>='),
        GText('>'),
        GText('<'),
        Equal
      ])
    ]),
    GSequence([
      f,
      GSelect([
        GText('in'),
        GText('is'),
        GText('as')
      ])
    ])
  ]);  
  

//ConstExpr -> <constant-expression>
  ConstExpr := GSelect([
    _String,
    GRepeat(
      Ident,
      Separated(
        GSelect([
          AddOp,
          MulOp
        ])
      )
    )
  ]);

//QualId -> [UnitId '.'] Ident
  QualId := TypeId;
//  QualId := GSequence([
//    GMaybe([
//      UnitId,
//      Dot
//    ]),
//    Ident
//  ]);

//  IdentList -> Ident/','...
  IdentList := GRepeat(
    Ident,
    Separated(Comma)
  );

//  ContainsClause -> CONTAINS IdentList... ';'
  ContainsClause := GSequence([
    GText('contains'),
    f,
    IdentList,
    mf,
    SemiColon
  ]);

//  InterfaceHeritage -> '(' IdentList ')'
  InterfaceHeritage := GSequence([
    OpenedArc,
    Separated(IdentList),
    ClosedArc
  ]);

//RequiresClause -> REQUIRES IdentList... ';'
  RequiresClause := GSequence([
    GText('requires'),
    f,
    IdentList,
    mf,
    SemiColon
  ]);

//VariantType -> VARIANT
//    -> OLEVARIANT
  VariantType := GSelect([
    GText('variant'),
    GText('olevariant')
  ]);

//SubrangeType -> ConstExpr '..' ConstExpr
  SubrangeType := GSequence([
    ConstExpr,
    Separated(OpDoubleDot),
    ConstExpr
  ]);

//EnumeratedType -> '(' IdentList ')'
  EnumeratedType := GSequence([
    OpenedArc,
    Separated(IdentList),
    ClosedArc
  ]);

//LabelDeclSection -> LABEL LabelId
  LabelDeclSection := GSequence([
    GText('label'),
    LabelId
  ]);

//RecordFieldConstant -> Ident ':' TypedConstant
  RecordFieldConstant := GSequence([
    Ident,
    Separated(Colon),
    GFar(@TypedConstant)
  ]);

//  RecordConstant -> '(' RecordFieldConstant/';'... ')'
  RecordConstant := GSequence([
    OpenedArc,
    GRepeat(
      RecordFieldConstant,
      Separated(SemiColon)
    ),
    ClosedArc
  ]);

//ArrayConstant -> '(' TypedConstant/','... ')'
  ArrayConstant := GSequence([
    OpenedArc,
    mf,
    GRepeat(
      GFar(@TypedConstant),
      Separated(Comma)
    ),
    mf,
    ClosedArc
  ]);

//TypedConstant -> (ConstExpr | ArrayConstant | RecordConstant)
  TypedConstant := GSelect([
    ConstExpr,
    ArrayConstant,
    RecordConstant
  ]);

//UsesClause -> USES IdentList ';'
  UsesClause := GSequence([
    GText('uses'),
    f,
    IdentList,
    mf,
    SemiColon
  ]);

//ClassRefType -> CLASS OF TypeId
  ClassRefType := GSequence([
    GText('class'),
    f,
    GText('of'),
    f,
    TypeId
  ]);

//RealType -> REAL48
//   -> REAL
//   -> SINGLE
//   -> DOUBLE
//   -> EXTENDED
//   -> CURRENCY
//   -> COMP
  RealType := GSelect([
    GText('real48'),
    GText('real'),
    GText('single'),
    GText('double'),
    GText('extended'),
    GText('currency'),
    GText('comp')
  ]);

//OrdIdent -> SHORTINT
//   -> SMALLINT
//   -> INTEGER
//   -> BYTE
//   -> LONGINT
//   -> INT64
//   -> WORD
//   -> BOOLEAN
//   -> CHAR
//   -> WIDECHAR
//   -> LONGWORD
//   -> PCHAR
  OrdIdent := GSelect([
    GText('smallint'),
    GText('integer'),
    GText('byte'),
    GText('longint'),
    GText('int64'),
    GText('word'),
    GText('boolean'),
    GText('char'),
    GText('widechar'),
    GText('longword'),
    GText('pchar')
  ]);

//OrdinalType -> (SubrangeType | EnumeratedType | OrdIdent)
  OrdinalType := GSelect([
    SubrangeType,
    EnumeratedType,
    OrdIdent
  ]);

//SimpleType -> (OrdinalType | RealType)
  SimpleType := GSelect([
    OrdinalType,
    RealType
  ]);

//StringType -> STRING
//     -> ANSISTRING
//     -> WIDESTRING
//     -> STRING '[' ConstExpr ']'
  StringType := GSelect([
    GSequence([
      GText('string'),
      GMaybe([
        mf,
        OpenedSquaredArc,
        Separated(ConstExpr),
        ClosedSquaredArc
      ])
    ]),
    GText('widestring'),
    GText('ansistring')
  ]);

//ArrayType -> ARRAY ['[' OrdinalType/','... ']'] OF Type
  ArrayType := GSequence([
    GText('array'),
    GMaybe([
      mf,
      OpenedSquaredArc,
      mf,
      GRepeat(
        OrdinalType,
        Separated(Comma)
      ),
      mf,
      ClosedSquaredArc
    ]),
    mf,
    GText('of'),
    f,
    GFar(@_Type)
  ]);

//  SetType -> SET OF OrdinalType
  SetType := GSequence([
    GText('set'),
    f,
    GText('of'),
    f,
    OrdinalType
  ]);

//FileType -> FILE OF TypeId
  FileType := GSequence([
    GText('file'),
    f,
    GText('of'),
    f,
    TypeId
  ]);

//PointerType -> '^' TypeId
  PointerType := GSequence([
    OpPointer,
    mf,
    TypeId
  ]);

//  CaseLabel -> ConstExpr ['..' ConstExpr]
  CaseLabel := GSequence([
    ConstExpr,
    GMaybe([
      Separated(OpDoubleDot),
      ConstExpr
    ])
  ]);  

//Directive -> CDECL
//    -> REGISTER
//    -> DYNAMIC
//    -> VIRTUAL
//    -> EXPORT
//    -> EXTERNAL
//    -> FAR
//    -> FORWARD
//    -> MESSAGE
//    -> OVERRIDE
//    -> OVERLOAD
//    -> PASCAL
//    -> REINTRODUCE
//    -> SAFECALL
//    -> STDCALL
  Directive := GSelect([
      GText('register'),
      GText('dynamic'),
      GText('virtual'),
      GText('export'),
      GText('external'),
      GText('far'),
      GText('forward'),
      GText('message'),
      GText('override'),
      GText('overload'),
      GText('pascal'),
      GText('reintroduce'),
      GText('safecall'),
      GText('stdcall')
  ]);

//Parameter -> IdentList  [':' ([ARRAY OF] SimpleType | STRING | FILE)]
//    -> Ident ':' SimpleType '=' ConstExpr
  Parameter := GSelect([
    GSequence([
      IdentList,
      GMaybe([
        Separated(Colon),
        GSelect([
          GMaybe([
            GText('array'),
            f,
            GText('of'),
            f,
            SimpleType
          ]),
          GText('string'),
          GText('file')
        ])
      ])
    ]),
    GSequence([
      Ident,
      Colon,
      SimpleType,
      Equal,
      ConstExpr
    ])
  ]);

//FormalParm -> [VAR | CONST | OUT] Parameter
  FormalParm := GSequence([
    GSelect([
      GText('var'),
      GText('const'),
      GText('out')
    ]),
    f,
    Parameter
  ]);  

//PropertySpecifiers -> [INDEX ConstExpr]
//        [READ Ident]
//        [WRITE Ident]
//        [STORED (Ident | Constant)]
//        [(DEFAULT ConstExpr) | NODEFAULT]
//        [IMPLEMENTS TypeId]
  PropertySpecifiers := GSequence([
    GMaybe([
      GText('index'),
      f,
      ConstExpr
    ]),
    GMaybe([
      GText('read'),
      f,
      Ident
    ]),
    GMaybe([
      GText('write'),
      f,
      Ident
    ]),
    GMaybe([
      GText('stored'),
      f,
      GSelect([
        Ident,
        GText('true'),
        GText('false')
      ])
    ]),
    GMaybe(
      GSelect([
        GSequence([
          GText('default'),
          f,
          ConstExpr
        ]),
        GText('nodefault')
      ])
    ),
    GMaybe([
      GText('implements'),
      f,
      TypeId
    ])
  ]);  

//ObjFieldList -> (IdentList ':' Type)/';'...
  ObjFieldList := GRepeat([
    IdentList,
    Colon,
    GFar(@_Type)
  ], 1);

//PropertyParameterList -> '[' (IdentList ':' TypeId)/';'... ']'
  PropertyParameterList := GSequence([
    OpenedSquaredArc,
    GRepeat([
      IdentList,
      Colon,
      TypeId,
      SemiColon
    ], 1),
    ClosedSquaredArc
  ]);

//PropertyInterface -> [PropertyParameterList] ':' Ident
  PropertyInterface := GSequence([
    GMaybe(PropertyParameterList),
    Colon,
    Ident
  ]);  

//ClassVisibility -> [PUBLIC | PROTECTED | PRIVATE | PUBLISHED]
  ClassVisibility := GSequence([
    f,
    GSelect([
      GText('public'),
      GText('protected'),
      GText('private'),
      GText('published')
    ]),
    f
  ]);

//  PropertyList -> PROPERTY  Ident [PropertyInterface]  PropertySpecifiers
  PropertyList := GSequence([
    GText('property'),
    f,
    Ident,
    mf,
    GMaybe(PropertyInterface),
    GMaybe(PropertySpecifiers)
  ]);

//  ClassPropertyList -> (ClassVisibility PropertyList ';')...
  ClassPropertyList := GRepeat([
    ClassVisibility,
    PropertyList,
    SemiColon
  ], 1);

//FormalParameters -> '(' FormalParm/';'... ')'
  FormalParameters := GSequence([
    OpenedArc,
    GRepeat([
      FormalParm,
      SemiColon
    ], 1),
    ClosedArc
  ]);

//FunctionHeading -> FUNCTION Ident [FormalParameters] ':' (SimpleType | STRING)
  FunctionHeading := GSequence([
    GText('function'),
    f,
    Ident,
    Separated(
      GMaybe(
        FormalParameters
      )
    ),
    Colon,
    mf,
    GSelect([
      SimpleType,
      GText('string')
    ])
  ]);

//ProcedureHeading -> PROCEDURE Ident [FormalParameters]
  ProcedureHeading := GSequence([
    GText('procedure'),
    f,
    Ident,
    mf,
    GMaybe(
      FormalParameters
    )
  ]);

// ConstructorHeading -> CONSTRUCTOR Ident [FormalParameters]
  ConstructorHeading := GSequence([
    GText('constructor'),
    f,
    Ident,
    mf,
    GMaybe(
      FormalParameters
    )
  ]);

//DestructorHeading -> DESTRUCTOR Ident [FormalParameters]
  DestructorHeading := GSequence([
    GText('destructor'),
    f,
    Ident,
    mf,
    GMaybe(
      FormalParameters
    )
  ]);

//MethodHeading -> ProcedureHeading
//      -> FunctionHeading
//      -> ConstructorHeading
//      -> DestructorHeading
  MethodHeading := GSelect([
    FunctionHeading,
    ConstructorHeading,
    DestructorHeading
  ]);


//MethodList -> (MethodHeading [';' VIRTUAL])/';'...
  MethodList := GRepeat(
    GSequence([
      MethodHeading,
      mf,
      GMaybe([
        SemiColon,
        mf,
        GText('virtual')
      ])
    ]),
    Separated(SemiColon)
  );

//  ClassMethodList -> (ClassVisibility MethodList)/';'...
  ClassMethodList := GRepeat(
    GSequence([
      ClassVisibility,
      f,
      MethodList
    ]),
    Separated(SemiColon)
  );

//  ClassHeritage -> '(' IdentList ')'
  ClassHeritage := GSequence([
    OpenedArc,
    Separated(IdentList),
    ClosedArc
  ]);

//  ClassFieldList -> (ClassVisibility ObjFieldList)/';'...
  ClassFieldList := GRepeat(
    GSequence([
      ClassVisibility,
      mf,
      ObjFieldList
    ]),
    Separated(SemiColon)
  );  

//ClassType -> CLASS [ClassHeritage]
//     [ClassFieldList]
//     [ClassMethodList]
//     [ClassPropertyList]
//     END
  ClassType := GSequence([
    GText('class'),
    f,
    GMaybe([
      ClassHeritage,
      mf
    ]),
    GMaybe([
      ClassFieldList,
      mf
    ]),
    GMaybe([
      ClassMethodList,
      mf
    ]),
    GMaybe([
      ClassPropertyList,
      mf
    ]),
    GText('end')
  ]);

//  ObjHeritage -> '(' QualId ')'
  ObjHeritage := GSequence([
    OpenedArc,
    Separated(QualId),
    ClosedArc
  ]);

//ObjectType -> OBJECT [ObjHeritage] [ObjFieldList] [MethodList] END
  ObjectType := GSequence([
    GText('object'),
    f,
    GMaybe([
      ObjHeritage,
      mf
    ]),
    GMaybe([
      ObjFieldList,
      mf
    ]),
    GMaybe([
      MethodList,
      mf
    ]),
    GText('end')
  ]);

//InterfaceType -> INTERFACE [InterfaceHeritage]
//       [ClassMethodList]
//       [ClassPropertyList]
//       END

  InterfaceType := GSequence([
    GText('INTERFACE'),
    f,
    GMaybe([
      InterfaceHeritage,
      mf
    ]),
    GMaybe([
      ClassMethodList,
      mf
    ]),
    GMaybe([
      ClassPropertyList,
      mf
    ])
  ]);

//ProcedureType -> (ProcedureHeading | FunctionHeading) [OF OBJECT]
  ProcedureType := GSequence([
    GSelect([
      ProcedureHeading,
      FunctionHeading
    ]),
    mf,
    GMaybe([
      GText('of'),
      f,
      GText('object')
    ])
  ]);

//RecType -> RECORD [FieldList] END
  RecType := GSequence([
    GText('record'),
    f,
    GMaybe(
      GFar(@FieldList)
    ),
    GText('end')
  ]);

//StrucType -> [PACKED] (ArrayType | SetType | FileType | RecType)
  StrucType := GSequence([
    GMaybe(
      GText('packed')
    ),
    GSelect([
      ArrayType,
      SetType,
      FileType,
      RecType
    ])
  ]);

//Type -> TypeId
//   -> SimpleType
//   -> StrucType
//   -> PointerType
//   -> StringType
//   -> ProcedureType
//   -> VariantType
//   -> ClassRefType
  _Type := GSelect([
    TypeId,
    SimpleType,
    StrucType,
    PointerType,
    StringType,
    ProcedureType,
    VariantType,
    ClassRefType
  ]);

//FieldDecl -> IdentList ':' Type
  FieldDecl := GSequence([
    IdentList,
    SemiColon,
    _Type
  ]);

//VarDecl -> IdentList ':' Type [(ABSOLUTE (Ident | ConstExpr)) | '=' ConstExpr]
  VarDecl := GSequence([
    IdentList,
    Colon,
    _Type,
    GMaybe(
      GSelect([
        GSequence([
          GText('absolute'),
          f,
          GSelect([
            Ident,
            ConstExpr
          ])
        ]),
        ConstExpr
      ])
    )
  ]);

//RecVariant -> ConstExpr/','...  ':' '(' [FieldList] ')'
  RecVariant := GSequence([
    GRepeat([
      ConstExpr,
      Comma
    ]),
    Colon,
    OpenedArc,
    GMaybe(
     GFar(@FieldList)
    ),
    ClosedArc
  ]);

//VariantSection -> CASE [Ident ':'] TypeId OF RecVariant/';'...
  VariantSection := GSequence([
    GText('case'),
    GMaybe([
      Ident,
      Colon
    ]),
    TypeId,
    GText('of'),
    GRepeat([
      RecVariant,
      SemiColon
    ])
  ]);

//FieldList ->  FieldDecl/';'... [VariantSection] [';']
  FieldList := GSequence([
    GRepeat([
      FieldDecl,
      SemiColon
    ]),
    GMaybe(
      VariantSection
    ),
    GMaybe(SemiColon)
  ]);


//RestrictedType -> ObjectType
//     -> ClassType
//     -> InterfaceType
  RestrictedType := GSelect([
    ObjectType,
    ClassType,
    InterfaceType
  ]);


//TypeDecl -> Ident '=' Type
//   -> Ident '=' RestrictedType
  TypeDecl := GSequence([
    Ident,
    Equal,
    GSelect([
      _Type,
      RestrictedType
    ])
  ]);

//TypeSection -> TYPE (TypeDecl ';')...
  TypeSection := GSequence([
    GText('type'),
    GRepeat([
      TypeDecl,
      SemiColon
    ], 1)
  ]);


//ConstantDecl -> Ident '=' ConstExpr
//     -> Ident ':' TypeId '=' TypedConstant
  ConstantDecl := GSelect([
    GSequence([
      Ident,
      Equal,
      ConstExpr
    ]),
    GSequence([
      Ident,
      Colon,
      TypeId,
      Equal,
      TypedConstant
    ])
  ]);


//  ConstSection -> CONST (ConstantDecl ';')...
  ConstSection := GSequence([
    GText('const'),
    GRepeat([
      ConstantDecl,
      SemiColon
    ], 1)
  ]);

//VarSection -> VAR (VarDecl ';')...
  VarSection := GSequence([
    GText('var'),
    GRepeat([
      VarDecl,
      SemiColon
    ], 1)
  ]);

//ExportedHeading -> ProcedureHeading ';' [Directive]
//      -> FunctionHeading ';' [Directive]
// TODO: Bring common part out of 'arcs'
  ExportedHeading := GSelect([
    GSequence([
      ProcedureHeading,
      SemiColon,
      GMaybe(Directive)
    ]),
    GSequence([
      FunctionHeading,
      SemiColon,
      GMaybe(Directive)
    ])
  ]);

//InterfaceDecl -> ConstSection
//      -> TypeSection
//      -> VarSection
//      -> ExportedHeading
  InterfaceDecl := GSelect([
    ConstSection,
    TypeSection,
    VarSection,
    ExportedHeading
  ]);

//InterfaceSection -> INTERFACE
//        [UsesClause]
//        [InterfaceDecl]...
  InterfaceSection := GSequence([
    GText('interface'),
    f,
    GMaybe(UsesClause),
    GMaybe(InterfaceDecl)
  ]);

//ProcedureDecl -> ProcedureHeading ';' [Directive]
//       Block ';'
  ProcedureDecl := GSequence([
    ProcedureHeading,
    SemiColon,
    GMaybe(
      Directive
    ),
    GFar(@Block),
    SemiColon
  ]);

//FunctionDecl -> FunctionHeading ';' [Directive]
//      Block ';'
  FunctionDecl := GSequence([
    FunctionHeading,
    SemiColon,
    GMaybe(
      Directive
    ),
    GFar(@Block),
    SemiColon
  ]);  

//ProcedureDeclSection -> ProcedureDecl
//       -> FunctionDecl
  ProcedureDeclSection := GSelect([
    ProcedureDecl,
    FunctionDecl
  ]);

//DeclSection -> LabelDeclSection
//    -> ConstSection
//    -> TypeSection
//    -> VarSection
//    -> ProcedureDeclSection
  DeclSection := GSelect([
    LabelDeclSection,
    ConstSection,
    TypeSection,
    VarSection,
    ProcedureDeclSection
  ]);  


//ImplementationSection -> IMPLEMENTATION
//         [UsesClause]
//         [DeclSection]...
  ImplementationSection := GSequence([
    GText('implementation'),
    f,
    GMaybe(UsesClause),
    GRepeats(DeclSection)
  ]);


// TODO: Far usages are optimized from beginig to this line. Next statements are to be optimized

//Block -> [DeclSection]
//   CompoundStmt
  Block := GSequence([
    GMaybe(DeclSection),
    GFar(@CompoundStmt)
  ]);

//ProgramBlock -> [UsesClause]
//      Block
  ProgramBlock := GSequence([
    GMaybe(UsesClause),
    Block
  ]);

//Term -> Factor [MulOp Factor]...
  Term := GRepeat(
    GFar(@Factor),
    GSequence([
      MulOp,
      mf
    ])
  );

//SimpleExpression -> ['+' | '-'] Term [AddOp Term]...
  SimpleExpression := GSequence([
    mf,
    GMaybe(
      GSelect([
        OpPlus,
        OpMinus
      ])
    ),
    mf,
    GRepeat(
      Term,
      GSequence([
        AddOp,
        mf
      ])
    )
  ]);  

//Expression -> SimpleExpression [RelOp SimpleExpression]...
  Expression := GRepeat(
    SimpleExpression,
    GSequence([
      RelOp,
      mf
    ])
  );

//  SetElement -> Expression ['..' Expression]
  SetElement := GSequence([
    Expression,
    mf,
    GMaybe([
      OpDoubleDot,
      mf,
      Expression
    ])
  ]);

//SetConstructor -> '[' [SetElement/','...] ']'
  SetConstructor := GSequence([
    OpenedSquaredArc,
    mf,
    GMaybe(
      GRepeat(
        SetElement,
        Separated(Comma)
      )
    ),
    mf,
    ClosedSquaredArc
  ]);  

//  ExprList -> Expression/','...
  ExprList := GRepeat(
    Expression,
    Separated(Comma)
  );

//Factor -> Designator ['(' ExprList ')']
//   -> '' Designator
//   -> Number
//   -> String
//   -> NIL
//   -> '(' Expression ')'
//   -> NOT Factor
//   -> SetConstructor
//   -> TypeId '(' Expression ')'
  Factor := GSelect([
    GSequence([
      GText('not'),
      f,
      GFar(@Factor)
    ]),  
    GSequence([
      GFar(@Designator),
      GMaybe([
        mf,
        OpenedArc,
        mf,
        GMaybe(ExprList),
        mf,
        ClosedArc
      ])
    ]),
    Number,
    _String,
    GText('nil'),
    GSequence([
      OpenedArc,
      mf,
      Expression,
      mf,
      ClosedArc
    ]),
    SetConstructor,
    GSequence([
      TypeId,
      mf,
      OpenedArc,
      mf,
      Expression,
      mf,
      ClosedArc
    ])
  ]);

//Designator -> QualId ['.' Ident | '[' ExprList ']' | '^']...
  Designator := GFilter(
    GSequence([
      QualId,
      GRepeats(
        GSelect([
          GSequence([
            Separated(Dot),
            Ident
          ]),
          GSequence([
            mf,
            OpenedSquaredArc,
            Separated(ExprList),
            ClosedSquaredArc
          ]),
          GSequence([
            mf,
            OpPointer
          ])
        ])
      )
    ]),
    DesignatorLexemeFilter
  );

//SimpleStatement -> Designator ['(' ExprList ')']
//      -> Designator ':=' Expression
//      -> INHERITED
//      -> GOTO LabelId
  SimpleStatement := GSelect([
    GSequence([
      GText('goto'),
      f,
      LabelId
    ]),
    GSequence([
      Designator,
      Separated(Assign),
      Expression
    ]),
    GSequence([
      Designator,
      GMaybe([
        mf,
        OpenedArc,
        Separated(ExprList),
        ClosedArc
      ])
    ])
  ]);  

//Statement -> [LabelId ':'] [SimpleStatement | StructStmt]
  Statement := GSelect([
    GFar(@StructStmt),
    SimpleStatement
  ]);
  Statement := GSelect([
    GSequence([
      LabelId,
      Separated(Colon),
      Statement
    ]),
    Statement
  ]);

//StmtList -> Statement/';'...
  StmtList := GSequence([
    GRepeat(
      Statement,
      GRepeat([
        mf,
        SemiColon,
        mf
      ])
    ),
    GRepeat([
      mf,
      SemiColon    
    ])
  ]);

//CompoundStmt -> BEGIN StmtList END
  CompoundStmt := GSequence([
    GText('begin'),
    f,
    GMaybe(StmtList),
    mf,
    GText('end')
  ]);

//IfStmt -> IF Expression THEN Statement [ELSE Statement]
  IfStmt := GSelect([
    CompoundStmt,
    Statement
  ]);
  IfStmt := GSequence([
    GText('if'),
    f,
    Expression,
    f,
    GText('then'),
    f,
    IfStmt,
    GMaybe([
      f,
      GText('else'),
      f,
      IfStmt
    ])
  ]);

//CaseSelector -> CaseLabel/','... ':' Statement
  CaseSelector := GSequence([
    GRepeat(
      CaseLabel,
      Separated(Comma)
    ),
    Separated(Colon),
    Statement
  ]);


//CaseStmt -> CASE Expression OF CaseSelector/';'... [ELSE Statement] [';'] END
  CaseStmt := GSequence([
    GText('case'),
    f,
    Expression,
    f,
    GText('of'),
    f,
    GRepeat(
      CaseSelector,
      SemiColon
    ),
    mf,
    GMaybe([
      GText('else'),
      Statement
    ]),
    mf,
    GMaybe(SemiColon),
    mf,
    GText('end')
  ]);

//ConditionalStmt -> IfStmt
//      -> CaseStmt
  ConditionalStmt := GSelect([
    IfStmt,
    CaseStmt
  ]);  

//  RepeatStmt -> REPEAT Statement UNTIL Expression
  RepeatStmt := GSequence([
    GText('repeat'),
    Statement,
    GText('until'),
    Expression
  ]);

//WhileStmt -> WHILE Expression DO Statement
  WhileStmt := GSequence([
    GText('while'),
    Expression,
    GText('do'),
    Statement
  ]);

//ForStmt -> FOR QualId ':=' Expression (TO | DOWNTO) Expression DO Statement
  ForStmt := GSequence([
    GText('for'),
    QualId,
    Assign,
    Expression,
    f,
    GSelect([
      GText('to'),
      GText('downto')
    ]),
    f,
    Expression,
    GText('do'),
    Statement
  ]);

//WithStmt -> WITH IdentList DO Statement
  WithStmt := GSequence([
    GText('with'),
    f,
    IdentList,
    f,
    GText('do'),
    f,
    Statement
  ]);

//LoopStmt -> RepeatStmt
//   -> WhileStmt
//   -> ForStmt
  LoopStmt := GSelect([
    RepeatStmt,
    WhileStmt,
    ForStmt
  ]);  

//StructStmt -> CompoundStmt
//     -> ConditionalStmt
//     -> LoopStmt
//     -> WithStmt
  StructStmt := GSelect([
    CompoundStmt,
    ConditionalStmt,
    LoopStmt,
    WithStmt
  ]);  

//InitSection -> INITIALIZATION StmtList [FINALIZATION StmtList] END
//    -> BEGIN StmtList END
//    -> END
  InitSection := GSelect([
    GText('initialization'),
    f,
    StmtList,
    GMaybe([
      GText('finalization'),
      f,
      StmtList
    ]),
    f,
    GText('end')
  ]);

//Program -> [PROGRAM Ident ['(' IdentList ')'] ';']
//     ProgramBlock '.'
  _Program := GSequence([
    GMaybe([
      mf,
      GText('program'),
      f,
      Ident,
      GMaybe([
        OpenedArc,
        IdentList,
        ClosedArc
      ]),
      SemiColon
    ]),
    ProgramBlock
  ]);

//Package -> PACKAGE Ident ';'
//     [RequiresClause]
//     [ContainsClause]
//     END '.'
  _Package := GSequence([
    mf,
    GText('package'),
    f,
    Ident,
    SemiColon,
    GMaybe(RequiresClause),
    GMaybe(ContainsClause),
    mf,
    GText('end'),
    Dot
  ]);

//Library -> LIBRARY Ident ';'
//     ProgramBlock '.'
  _Library := GSequence([
    mf,
    GText('library'),
    f,
    Ident,
    SemiColon,
    ProgramBlock,
    Dot
  ]);

//Unit -> UNIT Ident ';'
//    InterfaceSection
//    ImplementationSection
//    InitSection '.'
  _Unit := GSequence([
    mf,
    GText('unit'),
    f,
    Ident,
    mf,
    SemiColon,
    mf,
    InterfaceSection,
    mf,
    ImplementationSection,
    GMaybe(InitSection),
    Dot,
    mf
  ]);  

// Goal -> (Program | Package  | Library  | Unit)
  Goal := GSelect([
    _Unit,
    _Package,    
    _Program,
    _Library
  ]);

end;

{$IFDEF LEXEME_DEBUG}
initialization
  RegisterLabel(L_COMMENT1, '{Comment}');
  RegisterLabel(L_COMMENT2, '//Comment');
  RegisterLabel(L_FREE, 'Free space');
  RegisterLabel(L_COMMA, ',');
  RegisterLabel(L_SEMI_COLON, ';');
  RegisterLabel(L_COLON, ':');
  RegisterLabel(L_DOT, '.');
  RegisterLabel(L_EQUAL, '=');
  RegisterLabel(L_ASSIGN, ':=');
  RegisterLabel(L_OPENED_ARC, '(');
  RegisterLabel(L_CLOSED_ARC, ')');
  RegisterLabel(L_OPENED_SQUARED_ARC, '[');
  RegisterLabel(L_CLOSED_SQUARED_ARC, ']');
  RegisterLabel(L_PLUS, '+');
  RegisterLabel(L_MINUS, '-');
  RegisterLabel(L_MULTYPLY, '*');
  RegisterLabel(L_DIVIDE, '/');
  RegisterLabel(L_POINTER, '^');
  RegisterLabel(L_DOUBLE_DOT, '..');
{$ENDIF}

end.
